home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tricks of the Mac Game Programming Gurus
/
TricksOfTheMacGameProgrammingGurus.iso
/
More Source
/
Pascal
/
Book Demos in Pascal
/
TicTacToe
/
TicTacToe.p
< prev
next >
Wrap
Text File
|
1995-05-26
|
14KB
|
534 lines
program TicTacToe;
(* TicTacToe – prototype game example for the Mac Game book*)
(* By Ingemar Ragnemalm 1995*)
uses
{$IFC UNDEFINED THINK_PASCAL}
Types, QuickDraw, Fonts, Events, Packages, Menus, Dialogs, Windows,{}
OSUtils, ToolUtils, OSEvents, Resources,
{$ENDC}
Sound;
type
SndListHandle = Handle;
const
(*Size of the array*)
kArraySizeH = 3;
kArraySizeV = 3;
(*Size of the tiles*)
kTileSizeH = 64;
kTileSizeV = 64;
kNumTiles = 9;
(*Search depth - higher gives a better computer player*)
(*Everything above 0 plays ok*)
kMaxDepth = 2;
(* All the possible states of a tile *)
type
TileState = (empty, red, green);
(* The window pointer *)
var
myWindow: WindowPtr;
(* Data structure describing the game board *)
type
GameState = record
tiles: array[0..kNumTiles] of TileState; (* What is in each tile? *)
redCount, greenCount: Integer;
end;
var
gGameState: GameState;
(*Which tile is marked?*)
gMarkedTile: Point;
(* A boolean telling if we should quit yet or not *)
gDone: Boolean;
(* Pictures*)
emptyTile: PicHandle;
redTile: PicHandle;
greenTile: PicHandle;
redMarkedTile: PicHandle;
greenMarkedTile: PicHandle;
(* A function that converts two coordinates to a value that can be used as index in the tile array*)
function Point2Index (h: Integer; v: Integer): Integer;
begin
Point2Index := h + v * kArraySizeH;
Exit(Point2Index);
end; (*Point2Index*)
(* Draw a tile *)
procedure DrawTile (h: Integer; v: Integer);
var
tileRectangle: Rect;
begin
SetRect(tileRectangle, h * kTileSizeH, v * kTileSizeV, (h + 1) * kTileSizeH, (v + 1) * kTileSizeV);
case gGameState.tiles[Point2Index(h, v)] of
empty:
DrawPicture(emptyTile, tileRectangle);
red:
if (h = gMarkedTile.h) and (v = gMarkedTile.v) then
DrawPicture(redMarkedTile, tileRectangle)
else
DrawPicture(redTile, tileRectangle);
green:
if (h = gMarkedTile.h) and (v = gMarkedTile.v) then
DrawPicture(greenMarkedTile, tileRectangle)
else
DrawPicture(greenTile, tileRectangle);
otherwise
PaintRect(tileRectangle);
end;
end; (*DrawTile*)
function IsLine (state: GameState; h: Integer; v: Integer; dh: Integer; dv: Integer): Boolean;
var
i: Integer;
procedure Return (val: Boolean);
begin
IsLine := val;
exit(IsLine);
end;
begin
for i := 0 to 1 do
begin
if state.tiles[Point2Index(h + i * dh, v + i * dv)] = empty then
Return(false);
if state.tiles[Point2Index(h + i * dh, v + i * dv)] <> state.tiles[Point2Index(h + (i + 1) * dh, v + (i + 1) * dv)] then
Return(false);
end;
IsLine := true;
end; (*IsLine*)
function Analyze (state: GameState): Boolean;
procedure Return (val: Boolean);
begin
Analyze := val;
exit(Analyze);
end;
begin
{ The analysis here is just to check if there is a victory}
{ There are eight combinations:}
if IsLine(state, 0, 0, 1, 1) then { diagonal from top-left}
Return(true);
if (IsLine(state, 2, 0, -1, 1)) then { diagonal from top-right}
Return(true);
if (IsLine(state, 0, 0, 1, 0)) then { first row}
Return(true);
if (IsLine(state, 0, 1, 1, 0)) then { second row}
Return(true);
if (IsLine(state, 0, 2, 1, 0)) then { third row}
Return(true);
if (IsLine(state, 0, 0, 0, 1)) then { first column}
Return(true);
if (IsLine(state, 1, 0, 0, 1)) then { second column}
Return(true);
if (IsLine(state, 2, 0, 0, 1)) then { third column}
Return(true);
Return(false);
end; (*Analyze*)
(* Initialize - create window, load graphics *)
procedure InitTicTacToe;
var
windowRectangle: Rect;
i: Integer;
(*Set up the window*)
begin
SetRect(windowRectangle, 50, 50, 50 + kArraySizeH * kTileSizeH, 50 + kArraySizeV * kTileSizeV);
myWindow := NewCWindow(nil, windowRectangle, 'Tic-Tac-Toe', true, 0, WindowPtr(-1), false, 0);
SetPort(myWindow);
{$IFC UNDEFINED THINK_PASCAL}
qd.randSeed := TickCount; (*Seed the random number generator*)
{$ELSEC}
randSeed := TickCount; (*Seed the random number generator*)
{$ENDC}
emptyTile := GetPicture(131);
redTile := GetPicture(132);
greenTile := GetPicture(133);
redMarkedTile := GetPicture(134);
greenMarkedTile := GetPicture(135);
for i := 0 to kNumTiles - 1 do
gGameState.tiles[i] := empty;
gGameState.redCount := 0;
gGameState.greenCount := 0;
SetPt(gMarkedTile, -1, -1);
end; (*InitTicTacToe*)
(* ValidMove checks if a tile clickedTile is inside the array bounds *and* near the player *)
function ValidMove (clickedTile: Point): Boolean;
begin
(* Valid tile?*)
if clickedTile.h >= 0 then
if clickedTile.v >= 0 then
if clickedTile.h < kArraySizeH then
if clickedTile.v < kArraySizeV then
ValidMove := true
else
ValidMove := false;
end; (*ValidMove*)
{ FindComputerMove and FindPlayerMove are the two routines that perform the search.}
{They call each other, recursively, up to the search depth.}
{ return 1 if win}
{ return 0 if undecided}
{ return -1 if lose}
const
kWinningMove = 1;
kNoWinMove = 0;
kLosingMove = -1;
kNoMove = -2;
{prototype FindPlayerMove}
function FindPlayerMove (state: GameState; var returnState: GameState; depth: Integer): Integer;
forward;
function FindComputerMove (state: GameState; var returnState: GameState; depth: Integer): Integer;
var
tempState, junkState: GameState;
moveTo, moveFrom: Integer;
bestStateValue: Integer;
stateValue: Integer;
begin
bestStateValue := kNoMove;
returnState := state; { if all else fails}
if state.redCount < 3 then
begin
for moveTo := 0 to kNumTiles - 1 do
begin
if state.tiles[moveTo] = empty then
begin
tempState := state;
tempState.tiles[moveTo] := red;
tempState.redCount := tempState.redCount + 1;
if Analyze(tempState) then
begin
returnState := tempState;
FindComputerMove := kWinningMove;
exit(FindComputerMove);
end;
if depth < kMaxDepth then
stateValue := -FindPlayerMove(tempState, junkState, depth + 1)
else
stateValue := kNoWinMove; { When we can't seach futher, set to undecided}
if (stateValue > bestStateValue) then
begin
returnState := tempState;
bestStateValue := stateValue;
end
else if (stateValue = bestStateValue) then
if Random > 0 then
returnState := tempState;
end; {if empty}
end; {for}
end {if}
else
begin
for moveTo := 0 to kNumTiles - 1 do
for moveFrom := 0 to kNumTiles - 1 do
begin
if state.tiles[moveTo] = empty then
if state.tiles[moveFrom] = red then
begin
tempState := state;
tempState.tiles[moveTo] := red;
tempState.tiles[moveFrom] := empty;
if Analyze(tempState) then
begin
returnState := tempState;
FindComputerMove := kWinningMove;
exit(FindComputerMove);
end;
if depth < kMaxDepth then
stateValue := -FindPlayerMove(tempState, junkState, depth + 1)
else
stateValue := kNoWinMove;
if (stateValue > bestStateValue) then
begin
returnState := tempState;
bestStateValue := stateValue;
end
else if (stateValue = bestStateValue) then
if Random > 0 then
returnState := tempState;
end; {if empty}
end; {for}
end;{if else}
FindComputerMove := bestStateValue;
Exit(FindComputerMove);
end; (*FindComputerMove*)
{Same routine but for finding the best player move}
function FindPlayerMove (state: GameState; var returnState: GameState; depth: Integer): Integer;
var
tempState, junkState: GameState;
moveTo, moveFrom: Integer;
bestStateValue: Integer;
stateValue: Integer;
begin
bestStateValue := kNoMove;
returnState := state; { if all else fails}
if state.greenCount < 3 then
begin
for moveTo := 0 to kNumTiles - 1 do
begin
if state.tiles[moveTo] = empty then
begin
tempState := state;
tempState.tiles[moveTo] := green;
tempState.redCount := tempState.greenCount + 1;
if Analyze(tempState) then
begin
returnState := tempState;
FindPlayerMove := kWinningMove;
exit(FindPlayerMove);
end;
if depth < kMaxDepth then
stateValue := -FindPlayerMove(tempState, junkState, depth + 1)
else
stateValue := kNoWinMove; { When we can't seach futher, set to undecided}
if (stateValue > bestStateValue) then
begin
returnState := tempState;
bestStateValue := stateValue;
end
else if (stateValue = bestStateValue) then
if Random > 0 then
returnState := tempState;
end; {if empty}
end; {for}
end {if}
else
begin
for moveTo := 0 to kNumTiles - 1 do
for moveFrom := 0 to kNumTiles - 1 do
begin
if state.tiles[moveTo] = empty then
if state.tiles[moveFrom] = green then
begin
tempState := state;
tempState.tiles[moveTo] := green;
tempState.tiles[moveFrom] := empty;
if Analyze(tempState) then
begin
returnState := tempState;
FindPlayerMove := kWinningMove;
exit(FindPlayerMove);
end;
if depth < kMaxDepth then
stateValue := -FindComputerMove(tempState, junkState, depth + 1)
else
stateValue := kNoWinMove;
if (stateValue > bestStateValue) then
begin
returnState := tempState;
bestStateValue := stateValue;
end
else if (stateValue = bestStateValue) then
if Random > 0 then
returnState := tempState;
end; {if empty}
end; {for}
end;{if else}
FindPlayerMove := bestStateValue;
Exit(FindPlayerMove);
end; (*FindPlayerMove*)
(* Try to move the player to the position where we clicked. *)
procedure PlayerMove (clickedTile: Point);
var
h, v: Integer;
tileIndex: Integer;
oldMarkedTile: Point;
newState: GameState;
computerMoveResult: Integer;
err: OSErr;
begin
tileIndex := Point2Index(clickedTile.h, clickedTile.v);
(* Valid move?*)
if (ValidMove(clickedTile)) then
(* Yes! What is there? *)
begin
if gGameState.greenCount < 3 then
(* All pieces are not placed yet. Click must be in an empty space! *)
begin
if gGameState.tiles[tileIndex] <> empty then
begin
SysBeep(1);
exit(PlayerMove);
end;
gGameState.tiles[tileIndex] := green;
gGameState.greenCount := gGameState.greenCount + 1;
DrawTile(clickedTile.h, clickedTile.v);
if (Analyze(gGameState)) then
{ Victory! Play a sound and set gDone!}
begin
err := SndPlay(nil, SndListHandle(GetNamedResource('snd ', 'OK, you won')), false);
gDone := true;
exit(PlayerMove);
end;
end
else
(* All pieces are placed. *)
begin
if gGameState.tiles[tileIndex] = green then { Mark a tile for later movement}
begin
oldMarkedTile := gMarkedTile;
gMarkedTile.h := -1; { Make gMarkedTile invalid!}
DrawTile(oldMarkedTile.h, oldMarkedTile.v); { Redraw old marked tile, if any}
gMarkedTile := clickedTile; { Set new gMarkedTile}
DrawTile(gMarkedTile.h, gMarkedTile.v); { Draw new marked tile}
exit(PlayerMove);
end
else { Move a tile that was marked before}
if (gGameState.tiles[tileIndex] = empty) then
begin
if ValidMove(gMarkedTile) then
begin
gGameState.tiles[Point2Index(gMarkedTile.h, gMarkedTile.v)] := empty;
gGameState.tiles[tileIndex] := green;
oldMarkedTile := gMarkedTile;
gMarkedTile.h := -1; { Make gMarkedTile invalid!}
DrawTile(oldMarkedTile.h, oldMarkedTile.v); { Redraw old marked tile, if any}
DrawTile(clickedTile.h, clickedTile.v); { Draw moved tile }
if Analyze(gGameState) then
{ Victory! Play a sound and set gDone!}
begin
err := SndPlay(nil, SndListHandle(GetNamedResource('snd ', 'OK, you won')), false);
gDone := true;
Exit(PlayerMove);
end;
end { end valid gMarkedTile}
else
Exit(PlayerMove);
end { end click in empty space}
else (* Click in red tile. Beep and return. *)
begin
SysBeep(1);
exit(PlayerMove);
end;
end; { end if 3 green else}
{ If we get here, the player has made a valid move!}
computerMoveResult := FindComputerMove(gGameState, newState, 0);
gGameState := newState;
gMarkedTile.h := -1;
(*Draw all tiles!*)
for h := 0 to kArraySizeH - 1 do
for v := 0 to kArraySizeV - 1 do
DrawTile(h, v);
if Analyze(gGameState) then
{ Computer victory! Play a sound and set gDone!}
begin
err := SndPlay(nil, SndListHandle(GetNamedResource('snd ', 'Haha, I won')), false);
gDone := true;
exit(PlayerMove);
end;
end; { end ValidMove}
end; (*PlayerMove*)
(* Standard inits *)
procedure InitToolbox;
begin
{$IFC UNDEFINED THINK_PASCAL}
InitGraf(@qd.thePort);
InitFonts;
FlushEvents(everyEvent, 0);
InitWindows;
InitMenus;
TEInit;
InitDialogs(nil);
{$ENDC}
InitCursor;
end; (*InitToolbox*)
(* Main program *)
var
clickPoint, clickedTile: Point;
h, v: Integer;
begin
InitToolbox;
InitTicTacToe;
(*Draw all tiles!*)
for h := 0 to kArraySizeH - 1 do
for v := 0 to kArraySizeV - 1 do
DrawTile(h, v);
(*Initializations done! Run the game loop until the game ends.*)
repeat
if Button then
begin
GetMouse(clickPoint); (* Get the position of the click *)
clickedTile.h := clickPoint.h div kTileSizeH; (* Convert to grid. *)
clickedTile.v := clickPoint.v div kTileSizeV;
PlayerMove(clickedTile); (* Try to move there *)
while Button do
; (* Wait until the mouse click ends *)
end;
until gDone;
FlushEvents(mDownMask, 0); (* Get rid of mouse down events! *)
end. (*main program*)
(* What's left for making a real game of it?*)
(* Event processing, menus, "new game". That's about it. *)